com!online 2005 May/com_0505_1.iso/opensource/top10/amc_install.exe/{app}/Scripts/Cinefil (FR).ifs

Text File | 2004-10-16 | 13.7 KB | 345 lines

// GETINFO SCRIPTING
// Cinefil (FR) import avec grande Image

(***************************************************
 *  Script d'importation de film pour :            *
 *  CinΘfil.com , http://www.cinefil.com           *
 *                                                 *
 * correction suite α changement du site (v2)      *
 *  (c) 2004 scorpion7552                          *
 * script original par                             *
 *  (c) 2003 Danone-KiD                            *
 *                                                 *
 *  A utiliser avec Ant Movie Catalog 3.4.2        *
 *  www.antp.be/software/moviecatalog              *
 *                                                 *
 *  This program is free software; you can         *
 *  redistribute it and/or modify it under the     *
 *  terms of the GNU General Public License as     *
 *  published by the Free Software Foundation;     *
 *  either version 2 of the License, or (at your   *
 *  option) any later version.                     *
 ***************************************************)

program cinefil;
const
  CinefilBase = 'http://www.cinefil.com';
  CinefilUrl  = CinefilBase + '/cinefil2005/';
  crlf = #13#10;
  ExternalPictures = False;
  {  True: Les images seront stockΘes en tant que fichiers dans le mΩme dossier que le catalogue
     False: Les images seront stockΘes dans le catalogue (seulement pour les fichiers .amc)  }

var
  MovieName, Line: string;
  BeginPos, EndPos: Integer;
  filmok: Boolean;

//------------------------------------------------------------------------------
// RECHERCHE DU FILM (cinΘfil)
//------------------------------------------------------------------------------
procedure AnalyzePageCinefil(Address: string);
var
  Page: TStringList;
  Value,Value2,page_film,titre_film, annee_film,PagePrev,PageNext: string;

begin
  filmok := False;
  PageNext := '';
  PagePrev := '';
  PickTreeClear;                                       //vide la liste des films
  PickTreeAdd('Films (CinΘfil)', '');
  Line := GetPage(Address);
// SavePage('d:\Temp\choixCinefil.txt', Line);    // debug
  Value := ExtrStr(Line, '<B> RΘsultat ', '</B>');
  if Value = '' then
  begin
    ShowMessage('CinΘfil: erreur lecture page');          // non trouvΘ = erreur
    exit;
  end;
  if Copy(Value, 1, 1) = '0' then                              // 0 = aucun film
  begin
    ShowMessage('CinΘfil: aucun film trouvΘ pour "' + MovieName + '"');
    exit;
  end;

// recherche pages prΘcΘdente et suivante
  Line := ExtrStr(Line, 'RΘsultat', '');
  Value := ExtrStr(Line, '', '</TD>');              // Value = les url des pages
  if Pos('HREF', UpperCase(Value)) = 0 then
    Value := '';                                     // 1 seule page
  while Value <> '' do
  begin
  Value2 := ExtrStr(Value, '', '/a>');               // Value2 = url page xxx
  Delete(Value, 1, Pos('</a>', Value)+4);            // Value = les suivantes
// ignorer les "retours rapides" (<< et >>) pour ne pas confondre avec < et >
  if Pos('><<<', Value2) > 0 then
    continue;
  if Pos('>>><', Value2) > 0 then
    continue;
  if Pos('><<', Value2) > 0 then
  begin                                          // Value2 = url page prΘcΘdente
    PagePrev := GetUrl('', Value2, CinefilBase);
    PickTreeAdd('<<< page prΘcΘdente', PagePrev);
  end;
  if Pos('>><', Value2) > 0 then
    PageNext := GetUrl('', Value2, CinefilBase);   // Value2 = url page suivante
  end;                                             // end do while value <> ''
// mΘmo des films de cette page
  Value := '<font class=noir>';                           // sΘparateur de films
  repeat
// cherche le lien de la page du film
  BeginPos := Pos(Value, Line);                              // description film
  if BeginPos > 0 then                                          // 1 film trouvΘ
  begin
    Delete(Line, 1, BeginPos-1);
// url de la page
    page_film := GetUrl('HREF=''../fichefilm.cfm?ref=', Line, CinefilUrl);
// annΘe
    annee_film := FormatTitre(ExtrStr(Line, Value, ' '));
// nom du film et rΘalisateur
   BeginPos := Pos('TITLE="', UpperCase(Line));
   Delete(Line, 1, BeginPos);
   titre_film := ExtrStr(Line, '">', '</TD>');
   titre_film := StringReplace(titre_film, '</a>', ',');   // titre, rΘalisateur
   titre_film := FormatTitre(titre_film);
// ajoute le film
    PickTreeAdd(titre_film + ' ' + annee_film , page_film);
  end;
  until BeginPos = 0;
  if PageNext <> '' then
    PickTreeAdd('>>> page suivante', PageNext);
  if PickTreeExec(Address) then
  begin
    if (Address = PageNext) or (Address = PagePrev) then
      AnalyzePageCinefil(Address)                    // page suivante/prΘcΘdente
    else
    begin
      SetField(fieldURL, Address);
      AnalyzePageFilmCinefil(Address);                            // page film
    end;
  end else
    ShowMessage('CinΘfil: aucune page sΘlectionnΘe');
end;

//------------------------------------------------------------------------------
// ANALYSE DE LA PAGE DU FILM (CinΘfil)
//------------------------------------------------------------------------------
procedure AnalyzePageFilmCinefil(Address: string);
var
  Value,Value2,Value3,img: string;

begin
  filmok := True;
  Line := GetPage(Address);
  Line := ExtrStr(Line, 'RΘfΘrence film cinefil', '');          // vire le dΘbut
// SavePage('d:\Temp\filmCinefil.txt', Line);    // debug
// affiche: test s'il y a un grand format
  img := ExtrStr(Line, 'javascript:ZoomPhoto(''', '''');
  if img = '' then                        // sinon test s'il y a un petit format
    img := ExtrStr(Line, '<IMG class=photo SRC=''', '''');
  if img <> '' then
    GetPicture(img, ExternalPictures);
// pays annΘe et durΘe
  Value := ExtrStr(Line, '<font class="smallnoir">', '<BR>');
  Value := StringReplace(Value, '- ', '|');      // sΘpare les champs par |
  HTMLRemoveTags(Value);
  HTMLDecode(Value);
  BeginPos := Pos('|', Value);
  Value2 := Copy(Value, 1, BeginPos-1);            // pays (plusieurs possibles)
  Delete(Value, 1, BeginPos);
  if Value2 <> '' then
    SetField(fieldCountry, FormatTitre(Value2));
  BeginPos := Pos('|', Value);
  Value2 := Copy(Value, 1, BeginPos-1);                                 // annΘe
  Delete(Value, 1, BeginPos);
  if Value2 <> '' then
    SetField(fieldYear, FormatTitre(Value2));
  BeginPos := Pos('|', Value);
  Value2 := FormatTitre(Copy(Value, 1, BeginPos-1));                    // durΘe
  BeginPos := Pos('H', UpperCase(Value2));
  Value2 := IntToStr(StrToInt(Copy(Value2, 1, BeginPos-1), 0) * 60 + StrToInt(Copy(Value2, BeginPos+1, 2), 0));
  if Value2 <> '' then
    SetField(fieldLength, FormatTitre(Value2));
// titre original ou traduit
  Value3 := '<font class="noir"><font class="rouge16"><B>';
  BeginPos := Pos(Value3, Line) + Length(Value3);
  Value := ExtrStr(Line, Value3, '</B>');
// titre original Θventuel
  Value3 := '<BR>Titre original :<font class="smallrouge"> <B>';
  Value2 := ExtrStr(Line, Value3, '</B>');
  if Value2 = '' then                                    // 1er titre = original
  begin
    SetField(fieldOriginalTitle, FormatTitre(Value));
    SetField(fieldTranslatedTitle, '');
  end else
  begin                                                  // traduit + original
    BeginPos := Pos(Value3, Line) + Length(Value3);
    SetField(fieldOriginalTitle, FormatTitre(Value2));
    SetField(fieldTranslatedTitle, FormatTitre(Value));
  end;
  Delete(Line, 1, BeginPos-1);
  EndPos := Pos('</B>', Line);
  Delete(Line, 1, EndPos + 4);
// catΘgorie
  Value := ExtrStr(Line, '<BR>', crlf);
  Value := Trim(Value);
  BeginPos := Pos(' ', Value);                // virer l'article ('un' ou 'une')
  if Pos('UN', UpperCase(Copy(Value, 1, BeginPos))) > 0 then
    Delete(Value, 1, BeginPos);
  if Value <> '' then
    SetField(fieldCategory, FormatTitre(Value));
// rΘalisateur
  Value := ExtrStr(Line, '<B>', '</B>');
  if Value <> '' then
    SetField(fieldDirector, FormatTitre(Value));
// acteurs
  BeginPos := Pos('AVEC', UpperCase(Line));
  Delete(Line, 1, BeginPos);
  Value := ExtrStr(Line, '<B>', crlf);
  if Value <> '' then
    SetField(fieldActors, FormatTitre(Value));
// description
  Value := ExtrStr(Line, '<font class=smallnoir><BR><font class=noir>', '<BR>');
  if Value <> '' then
    SetField(fieldDescription, FormatText(Value));
{ on s'en fout, non?
  if img = '' then
    ShowMessage('CinΘfil: pas d''affiche prΘvue pour "' + MovieName + '"');
}
end;

//------------------------------------------------------------------------------
// formatage d'un texte pour affichage
// suppression des tags html, remplacement des caractΦres bizarres
//------------------------------------------------------------------------------
function FormatText(str1: string) :string;
var
  s: string;

begin
  str1 := StringReplace(str1, '<p>', '|');  // remplace temporairement <P> par |
  HTMLRemoveTags(str1);                     // supprime les tags HTML
  HTMLDecode(str1);                         // et les caractΦres spΘciaux
// supprimer les caractΦres de formatage en dΘbut de chaine (code ASCII <= x'20')
  repeat
  s := Copy(str1, 1, 1);                                // 1er caractΦre de str1
  if s <= #32 then
    Delete(str1, 1, 1);                                 // on le vire
  until s > #32;
// remet paragraphe = crlf
  str1 := StringReplace(str1, '|', crlf);
// caractΦres qui s'affichent mal
  str1 := StringReplace(str1, '£', 'oe');
  str1 := StringReplace(str1, #150, '-');      // le vrai tiret
  str1 := StringReplace(str1, #133, '...');    // les vrais points de suspension
  str1 := StringReplace(str1, #147, '"');      // citation ouvrante = "" ou #171
  str1 := StringReplace(str1, #148, '"');      // citation fermante = "" ou #187
  result := Trim(str1);
end;

//------------------------------------------------------------------------------
// formatage d'un titre (sur 1 seule ligne)
//------------------------------------------------------------------------------
function FormatTitre(str1: string) :string;
begin
  HTMLDecode(str1);
  HTMLRemoveTags(str1);
  str1 := StringReplace(str1, crlf, '');                    // sur 1 seule ligne
  result := Trim(str1);
end;

//------------------------------------------------------------------------------
// extraction d'une url contenue dans une chaine de caractΦres sans Θdition
// adr := GetUrl(texte_HREF_cherchΘ,chaine,url_de_base)
//------------------------------------------------------------------------------
function GetUrl(strfrom,str1,urlb: string) :string;
var
 i: Integer;
 delim: String;

begin
  if strfrom <> '' then                        // si from = '' on part du dΘbut
  begin
    i := Pos(strfrom, str1);                   // position href cherchΘ
    if i = 0 then                              // rien trouvΘ
    begin
      result := '';
      exit;
    end;
    Delete(str1,1, i -1);
  end;
  i := Pos('HREF=', UpperCase(str1));        // debut url: href=
  delim := Copy(str1, i+5, 1);               // fin = " ou '
  Delete(str1,1, i +5);
  i := Pos(delim, str1);
  if i > 0 then
    Delete(str1,i, Length(str1));
// il y a parfois des trucs en plus aprΦs l'url: donc α supprimer
  i := Pos('&mc=', str1);
  if i > 0 then
    Delete(str1, i, Length(str1));
  str1 := StringReplace(str1, '../', '');    // cf adresse relative
  str1 := StringReplace(str1, './', '');
  str1 := urlb + str1;                       // ajoute url de base
  result := Trim(str1);
end;

//------------------------------------------------------------------------------
// extraction de la chaine dΘlimitΘe par from et to dans str1
//------------------------------------------------------------------------------
function ExtrStr(str1,strfrom,strto: string) :string;
var
 i: Integer;

begin
  if strfrom <> '' then                         // si from = '' on part du dΘbut
  begin
    i := Pos(strfrom, str1);
    if i = 0 then                                             // from non trouvΘ
    begin
      result := '';
      exit;
    end;
    Delete(str1, 1, i + Length(strfrom) -1);
  end;
  i := Pos(strto, str1);                                     // fin de la chaine
  Delete(str1, i, Length(str1));
  result := Trim(str1);
end;

//------------------------------------------------------------------------------
// Θcriture d'une chaine sur disque (pour debug...)
// SavePage(chemin_du_fichier,chaine)
// chemin_du_fichier = chemin complet ex: 'c:\temp\monfichier.txt'
//------------------------------------------------------------------------------
procedure SavePage(fic, str1: string);
var
  Page2: TStringList;

begin
  page2 := TStringList.Create;
  page2.Text := str1;
  page2.SaveToFile(fic);
end;

//------------------------------------------------------------------------------
//  c'est ici que τa commence
//------------------------------------------------------------------------------
begin
  if CheckVersion(3,4,2) then
  begin
// cinΘfil prΘfΦre les titres en franτais (peut-Ωtre plus vrai,, mais bon...)
    MovieName := GetField(fieldTranslatedTitle);
    if MovieName = '' then
       MovieName := GetField(fieldOriginalTitle);
    if Input('cinΘfil.com Import avec image', 'Entrez le titre du film :', MovieName) then
    begin
      AnalyzePageCinefil(CinefilUrl + 'CFM_Recherches/films.cfm?lachaine2=' + UrlEncode(MovieName));
      if filmok then
        DisplayResults;
    end;
  end else
    ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.4.2)');
end.